home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / debconf-copydb < prev    next >
Encoding:
Text File  |  2009-10-02  |  1.7 KB  |  83 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. use strict;
  6. use Getopt::Long;
  7. use Debconf::Log qw{:all};
  8. use Debconf::Db;
  9. use Debconf::DbDriver;
  10. use Debconf::DbDriver::Backup;
  11.  
  12.  
  13. sub usage {
  14.     print STDERR <<EOF;
  15. Usage: debconf-copydb sourcedb destdb [--pattern=pattern] [--owner-pattern=pattern] [--config=Foo:bar]
  16. EOF
  17.     exit(1);
  18. }
  19.  
  20.  
  21. my $pattern='.*';
  22. my $owner_pattern;
  23.  
  24. my %config;
  25. sub config {
  26.     my ($field, $value)=split(/\s*:\s*/, $_[1], 2);
  27.     $field=~tr/-/_/;
  28.     $field=lc($field);
  29.     die "Parse error: \"$_[1]\"" unless defined $field and length $field;
  30.     
  31.     if ($field eq 'name') {
  32.         if ($config{name}) {
  33.             Debconf::Db->makedriver(%config);
  34.         }
  35.         elsif (%config) {
  36.             warn "ignoring command line config data before $_[1]";
  37.         }
  38.         %config=();
  39.     }
  40.  
  41.     $config{$field}=$value;
  42. }
  43.  
  44. GetOptions(
  45.     "pattern|p=s"    => \$pattern,
  46.     "config|c=s"    => \&config,
  47.     "owner-pattern=s" => \$owner_pattern,
  48. ) || usage();
  49. Debconf::Db->makedriver(%config) if %config;
  50.  
  51. my $srcname=shift || usage();
  52. my $destname=shift || usage();
  53.  
  54. Debconf::Db->load;
  55.  
  56. my $src=Debconf::DbDriver->driver($srcname);
  57. die "$0: source database, \"$srcname\" does not exist\n" unless ref $src;
  58. my $dest=Debconf::DbDriver->driver($destname);
  59. die "$0: destination database, \"$destname\" does not exist\n" unless ref $dest;
  60.  
  61. my $copier=Debconf::DbDriver::Backup->new(
  62.     db => $src, backupdb => $dest, name => 'copier');
  63.  
  64. my $i=$copier->iterator;
  65. while (my $item=$i->iterate) {
  66.     next unless $item =~ /$pattern/;
  67.  
  68.     if (defined $owner_pattern) {
  69.         my $fit_owner = 0;
  70.         my $owner;
  71.         foreach $owner ($src->owners($item)){
  72.             $fit_owner = 1 if $owner =~ /$owner_pattern/;
  73.         }
  74.         next unless $fit_owner;
  75.     }
  76.  
  77.     $copier->copy($item, $src, $dest);
  78. }
  79.  
  80. $copier->shutdown;
  81.  
  82.  
  83.